home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG Library 8 / PC-SIG Library CD-ROM (8th Edition) (1990-04).iso / 201_300 / disk0204 / fcopy.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-06-01  |  7.4 KB  |  314 lines
  1. { Copy disks for production }
  2.  
  3. { (C) Copyright 1983-84 Peter Norton }
  4.  
  5. { 06/06/84 - revised in a minor way for free distribution }
  6.  
  7. { 10/28/83 - changed to report i/o errors }
  8.  
  9. { 10/25/83 - changed 1) remove verify
  10.                      2) use chrget     }
  11.  
  12. {$debug-,$ocode-,$line-}
  13.  
  14. program fcopy (output,input);
  15.  
  16. var [static]
  17.   try_count: word;
  18.   ret_word : word;
  19.   err_code : byte;
  20.   inline   : lstring (100);
  21.   base     : ads of array [wrd(0)..4095] of byte;
  22.   store    : ads of array [wrd(0)..4095] of byte;
  23.   drive    : word;
  24.   track    : word;
  25.   inchr    : word;
  26.   done     : boolean;
  27.   
  28. value
  29.   done     := false;
  30.  
  31. procedure endxqq;
  32.   external;
  33.  
  34. procedure chrget (var x: word);
  35.   external;
  36.   
  37. procedure ifchr  (var x: word);
  38.   external;
  39.   
  40. {  These four routines return true if errors  }
  41.             
  42. function readt (drive,track,seg,off : word) : word;
  43.   external;
  44.  
  45. function writt (drive,track,seg,off : word) : word;
  46.   external;
  47.  
  48. function formt (drive,track,seg,off : word) : word;
  49.   external;
  50.  
  51. function verit (drive,track,seg,off : word) : word;
  52.   external;
  53.   
  54.   {---}
  55.  
  56. function readx (drive,track,seg,off : word) : boolean;
  57.   begin
  58.     for try_count := 1 to 3 do
  59.       begin
  60.         ret_word := readt (drive,track,seg,off);
  61.         err_code := ret_word div 256;
  62.         if ret_word = 0 then
  63.           begin
  64.             readx := false;
  65.             return;
  66.           end
  67.         else
  68.           readx := true;
  69.       end;
  70.   end;
  71.  
  72. function writx (drive,track,seg,off : word) : boolean;
  73.   begin
  74.     for try_count := 1 to 3 do
  75.       begin
  76.         ret_word := writt (drive,track,seg,off);
  77.         err_code := ret_word div 256;
  78.         if ret_word = 0 then
  79.           begin
  80.             writx := false;
  81.             return;
  82.           end
  83.         else
  84.           writx := true;
  85.       end;
  86.   end;
  87.  
  88. function formx (drive,track,seg,off : word) : boolean;
  89.   begin
  90.     for try_count := 1 to 3 do
  91.       begin
  92.         ret_word := formt (drive,track,seg,off);
  93.         err_code := ret_word div 256;
  94.         if ret_word = 0 then
  95.           begin
  96.             formx := false;
  97.             return;
  98.           end
  99.         else
  100.           formx := true;
  101.       end;
  102.   end;
  103.  
  104. function verix (drive,track,seg,off : word) : boolean;
  105.   begin
  106.     for try_count := 1 to 3 do
  107.       begin
  108.         ret_word := verit (drive,track,seg,off);
  109.         err_code := ret_word div 256;
  110.         if ret_word = 0 then
  111.           begin
  112.             verix := false;
  113.             return;
  114.           end
  115.         else
  116.           verix := true;
  117.       end;
  118.   end;
  119.   
  120. procedure initialize;
  121.   var [static]
  122.     i,j : word;
  123.   begin
  124.     
  125.     { set up the format control information }
  126.     
  127.     store.s := 6141;
  128.     store.r := 0;
  129.     
  130.     store ^ [ 0 + 0] := 0; { track number }
  131.     store ^ [ 0 + 1] := 0; { head number  }
  132.     store ^ [ 0 + 2] := 1; { record number }
  133.     store ^ [ 0 + 3] := 2; { size code for 512 }
  134.     
  135.     store ^ [ 4 + 0] := 0; { track number }
  136.     store ^ [ 4 + 1] := 0; { head number  }
  137.     store ^ [ 4 + 2] := 2; { record number }
  138.     store ^ [ 4 + 3] := 2; { size code for 512 }
  139.     
  140.     store ^ [ 8 + 0] := 0; { track number }
  141.     store ^ [ 8 + 1] := 0; { head number  }
  142.     store ^ [ 8 + 2] := 3; { record number }
  143.     store ^ [ 8 + 3] := 2; { size code for 512 }
  144.     
  145.     store ^ [12 + 0] := 0; { track number }
  146.     store ^ [12 + 1] := 0; { head number  }
  147.     store ^ [12 + 2] := 4; { record number }
  148.     store ^ [12 + 3] := 2; { size code for 512 }
  149.     
  150.     store ^ [16 + 0] := 0; { track number }
  151.     store ^ [16 + 1] := 0; { head number  }
  152.     store ^ [16 + 2] := 5; { record number }
  153.     store ^ [16 + 3] := 2; { size code for 512 }
  154.     
  155.     store ^ [20 + 0] := 0; { track number }
  156.     store ^ [20 + 1] := 0; { head number  }
  157.     store ^ [20 + 2] := 6; { record number }
  158.     store ^ [20 + 3] := 2; { size code for 512 }
  159.     
  160.     store ^ [24 + 0] := 0; { track number }
  161.     store ^ [24 + 1] := 0; { head number  }
  162.     store ^ [24 + 2] := 7; { record number }
  163.     store ^ [24 + 3] := 2; { size code for 512 }
  164.     
  165.     store ^ [28 + 0] := 0; { track number }
  166.     store ^ [28 + 1] := 0; { head number  }
  167.     store ^ [28 + 2] := 8; { record number }
  168.     store ^ [28 + 3] := 2; { size code for 512 }
  169.     
  170.     for i := 1 to 25 do
  171.       writeln;
  172.  
  173.     base.s := 6144;  { puts storage at the end of 256 K }
  174.     base.r := 0;
  175.     store  := base;
  176.     
  177.   end;
  178.  
  179. procedure read_disk;
  180.   var [static]
  181.     ii : word;
  182.     sowhat : boolean;
  183.   begin
  184.     drive := 0;
  185.     writeln;
  186.     writeln;
  187.     writeln ('Insert the disk to be copied in drive A, and press ANY KEY...');
  188.     chrget (inchr);
  189.     store := base;
  190.     
  191.     { start up drive }
  192.     for ii := 1 to 5 do
  193.       if not readx (drive,0,wrd (store.s),wrd (store.r)) then
  194.         break;
  195.           
  196.     for track := 0 to 39 do
  197.       begin
  198.         store.s := base.s + 256 * track;
  199.         write ('Reading track ',track:2);
  200.         ii := 0;
  201.         while readx (drive,track,wrd (store.s),wrd (store.r)) do
  202.           begin
  203.             ii := ii + 1;
  204.             if ii > 5 then
  205.               begin
  206.                 writeln;
  207.                 writeln ('Error reading track ',track:3);
  208.                 writeln;
  209.                 write (chr (7));
  210.                 endxqq;
  211.               end;
  212.           end;
  213.         write (chr (13));
  214.       end;
  215.     writeln;
  216.     writeln;
  217.     writeln ('Press the ESC key to pause after any disk.');
  218.     writeln;
  219.     writeln;
  220.   end;
  221.     
  222. procedure copy_disk;
  223.   var
  224.     i : word;
  225.   label
  226.     re_format;
  227.     
  228.   begin
  229.     writeln;
  230.     write ('Insert diskette in drive ');
  231.     if drive = 0 then
  232.       begin
  233.         drive := 1;
  234.         write ('B');
  235.       end
  236.     else
  237.       begin
  238.         drive := 0;
  239.         write ('A');
  240.       end;
  241.     writeln;
  242.     for track := 0 to 39 do
  243.       begin
  244.     
  245.         store.s := 6141;
  246.     
  247.         for i := 0 to 7 do
  248.           store ^ [i*4] := track;
  249.     
  250.         write (chr (13),track:2,' formatting');
  251. re_format:
  252.         if formx (drive,track,wrd (store.s),wrd (store.r)) then
  253.           begin
  254.             if track = 0 then
  255.               goto re_format;
  256.             writeln ('     E R R O R !  ',err_code);
  257.             writeln;
  258.             write (chr (7));
  259.             write (chr (7));
  260.             return;
  261.           end;
  262.       
  263.         store.s := base.s + 256 * track;
  264.     
  265.         write (chr (13),track:2,' writing   ');
  266.         if writx (drive,track,wrd (store.s),wrd (store.r)) then
  267.           begin
  268.             writeln ('     E R R O R !  ',err_code);
  269.             writeln;
  270.             write (chr (7));
  271.             write (chr (7));
  272.             return;
  273.           end;
  274.   
  275.       end; 
  276.  
  277.     write (chr(7));
  278.     writeln;
  279.   end;
  280.     
  281. procedure check_pause;
  282.   begin
  283.     ifchr (inchr);
  284.     inchr := inchr mod 256;
  285.     if inchr = 0 then
  286.       return;
  287.     if inchr <> 27 then
  288.       begin
  289.         writeln;
  290.         writeln ('Use the ESC key to pause after the end of a disk');
  291.         writeln;
  292.         return;
  293.       end;
  294.     write (chr(7));
  295.     writeln;
  296.     write   ('Press E to end, or any other key to continue...');
  297.     chrget (inchr);
  298.     inchr := inchr mod 256;
  299.     writeln;
  300.     if (inchr = 69) or (inchr = 101) then
  301.       done := true;
  302.     return;
  303.   end;
  304.     
  305. begin
  306.   initialize;
  307.   read_disk;
  308.   repeat
  309.     copy_disk;
  310.     check_pause;
  311.   until done;
  312. end.
  313.  
  314.